home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / rlib20.zip / DEMOPROC.PRG < prev    next >
Text File  |  1989-02-18  |  15KB  |  549 lines
  1. ******************************************************************************
  2. * THIS FILE CONTAINS THE PROCEDURES WHICH ACTUALLY DEMONSTRATE THE FUNCTIONS *
  3. ******************************************************************************
  4.  
  5.  
  6. *-----------------------------------------------------------------------------
  7. PROCEDURE d_atinsay
  8. mrow = 21
  9. mcol = 20
  10. mcolor = 'W+*/N   '
  11. mtext  = '           Testing: 1, 2, 3           '
  12. DO ClearTop
  13. @ 3,0,11,79 BOX double
  14. @ 5, 1 SAY 'Enter row,colum coordinates   ,'
  15. @ 5,29 GET mrow PICTURE '##' RANGE 0,24
  16. @ 5,32 GET mcol PICTURE '##' RANGE 0,79
  17. @ 6, 1 SAY 'Enter Clipper color string ' GET mcolor PICTURE "@!"
  18. @ 7, 1 SAY 'Enter the text to display  ' GET mtext  PICTURE "@K"
  19. SET CURSOR ON
  20. READ
  21. SET CURSOR OFF
  22. ATINSAY( mrow, mcol, mcolor, mtext )
  23. CENTER( 10, 'Press any key to continue...' )
  24. INKEY(10)
  25. RETURN
  26.  
  27.  
  28. *-----------------------------------------------------------------------------
  29. PROCEDURE d_boxask
  30. DO ClearTop
  31. SET CURSOR ON
  32. @ 3,0,11,79 BOX double
  33. @ 5,1 SAY 'Enter two lines of text to appear in BOXASK (up to 65 characters each)'
  34. @ 7,1 SAY 'Line #1: '
  35. mline1 = KEYINPUT( 65, .F., .T. )
  36. @ 8,1 SAY 'Line #2: '
  37. mline2 = KEYINPUT( 65, .F., .T. )
  38. answer = BOXASK( mline1, mline2, 'Now press any key...' )
  39. BOXASK( 'You pressed the ' + answer + ' key in response to BOXASK',;
  40.         'Press any key to continue...', 30 )
  41. SET CURSOR OFF
  42. RETURN
  43.  
  44.  
  45. *-----------------------------------------------------------------------------
  46. PROCEDURE d_bright
  47. DO ClearTop
  48. SET CURSOR ON
  49. mcolor = PAD(SETCOLOR(),20)
  50. @ 4,5,7,68 BOX double
  51. @ 5,12 SAY 'Enter a Clipper color string:' GET mcolor
  52. READ
  53. @ 6,12 SAY 'The BRIGHT() of this color is: ' + BRIGHT(mcolor)
  54. SET CURSOR OFF
  55. INKEY(10)
  56. RETURN
  57.  
  58.  
  59. *-----------------------------------------------------------------------------
  60. PROCEDURE d_center
  61. DO ClearTop
  62. SET CURSOR ON
  63. mstring = PAD('Greetings to all Clipper programmers!',78)
  64. @ 4,0,7,79 BOX double
  65. CENTER(5,'Enter a string to be centered')
  66. @ 6,1 GET mstring PICTURE "@K"
  67. READ
  68. @ 6,1 SAY SPACE(78)
  69. CENTER(6,ALLTRIM(mstring))
  70. SET CURSOR OFF
  71. INKEY(10)
  72. RETURN
  73.  
  74.  
  75. *-----------------------------------------------------------------------------
  76. PROCEDURE d_sayinbox
  77. DO ClearTop
  78. SET CURSOR ON
  79. @ 3,0,11,79 BOX double
  80. @ 5,1 SAY 'Enter three lines of text to appear in SAYINBOX (up to 65 characters each)'
  81. @ 7,1 SAY 'Line #1: '
  82. mline1 = KEYINPUT( 65, .F., .T. )
  83. @ 8,1 SAY 'Line #2: '
  84. mline2 = KEYINPUT( 65, .F., .T. )
  85. @ 9,1 SAY 'Line #3: '
  86. mline3 = KEYINPUT( 65, .F., .T. )
  87. SAYINBOX( mline1, mline2, mline3, 10 )
  88. SET CURSOR OFF
  89. RETURN
  90.  
  91.  
  92. *-----------------------------------------------------------------------------
  93. PROCEDURE d_filedate
  94. DO ClearTop
  95. SET CURSOR ON
  96. mfile = PAD(GETE('COMSPEC'),40)
  97. @ 4,0,7,79 BOX double
  98. CENTER(5,'Enter an existing filename:')
  99. @ 6,CENTER(mfile) GET mfile PICTURE "@!K"
  100. READ
  101. @ 6,1 SAY SPACE(78)
  102. mfile = ALLTRIM(mfile)
  103. CENTER(6, 'Last update date of &mfile is: ' + DTOC(FILEDATE(mfile)) )
  104. SET CURSOR OFF
  105. INKEY(10)
  106. RETURN
  107.  
  108.  
  109. *-----------------------------------------------------------------------------
  110. PROCEDURE d_files
  111. DO ClearTop
  112. SET CURSOR ON
  113. mfile1 = PAD('RLIB.LIB',60)
  114. mfile2 = PAD('DEMO.EXE',60)
  115. mfile3 = PAD('DEMO.PRG',60)
  116. @ 4,0,7,79 BOX double
  117. CENTER(5,"Enter files to test for existance:")
  118. @ 6, 2 SAY "#1:" GET mfile1 PICTURE "@!KS20"
  119. @ 6,28 SAY "#2:" GET mfile2 PICTURE "@!KS20"
  120. @ 6,54 SAY "#3:" GET mfile3 PICTURE "@!KS20"
  121. READ
  122. @ 6,1 SAY SPACE(78)
  123. mfile1 = ALLTRIM(mfile1)
  124. mfile2 = ALLTRIM(mfile2)
  125. mfile3 = ALLTRIM(mfile3)
  126. mdisplay = 'FILES("&mfile1", "&mfile2", "&mfile3") = ' +;
  127.             IF( FILES(mfile1, mfile2, mfile3), '.T.', '.F.' )
  128. CENTER(6,mdisplay)
  129. SET CURSOR OFF
  130. INKEY(10)
  131. RETURN
  132.  
  133.  
  134. *-----------------------------------------------------------------------------
  135. PROCEDURE d_filetime
  136. DO ClearTop
  137. SET CURSOR ON
  138. mfile = PAD(GETE('COMSPEC'),40)
  139. @ 4,0,7,79 BOX double
  140. CENTER(5,'Enter an existing filename:')
  141. @ 6,CENTER(mfile) GET mfile PICTURE "@!K"
  142. READ
  143. @ 6,1 SAY SPACE(78)
  144. mfile = ALLTRIM(mfile)
  145. CENTER(6, 'Last update time of &mfile is: ' + FILETIME(mfile) )
  146. SET CURSOR OFF
  147. INKEY(10)
  148. RETURN
  149.  
  150.  
  151. *-----------------------------------------------------------------------------
  152. PROCEDURE d_parent
  153. PRIVATE mdir
  154. DO ClearTop
  155. SET CURSOR ON
  156. mdir = PAD('C:\CLIPPER\LIBS\RLIB\SOURCE',40)
  157. @ 4,0,8,79 BOX double
  158. CENTER(5, 'Press ENTER or type in another directory name:')
  159. @ 6,CENTER(mdir) GET mdir PICTURE "@!K"
  160. READ
  161. @ 6,1 SAY SPACE(78)
  162. CENTER(6,ALLTRIM(mdir))
  163. CENTER(7,'The parent directory is ' + PARENT(mdir) )
  164. SET CURSOR OFF
  165. INKEY(10)
  166. RETURN
  167.  
  168.  
  169. *-----------------------------------------------------------------------------
  170. PROCEDURE d_pathto
  171. PRIVATE mfile, mpath
  172. DO ClearTop
  173. SET CURSOR ON
  174. mfile = "CLIPPER.EXE "
  175. @ 4,0,8,79 BOX double
  176. CENTER(5, 'Enter the name of a file which can be found through the DOS path')
  177. CENTER(6, '(Current DOS path is ' + GETE('PATH') + ')')
  178. @ 7,CENTER(mfile) GET mfile PICTURE "@!"
  179. READ
  180. mfile = ALLTRIM(mfile)
  181. mpath = PATHTO(mfile)
  182. IF EMPTY(mpath)
  183.    CENTER(7,'&mfile is not located in any directory in the DOS path!')
  184. ELSE
  185.    CENTER(7,'&mfile can be found in the &mpath directory')
  186. ENDIF
  187. SET CURSOR OFF
  188. INKEY(10)
  189. RETURN
  190.  
  191.  
  192. *-----------------------------------------------------------------------------
  193. PROCEDURE d_pickfile
  194. DO ClearTop
  195. @ 5,15,7,65 BOX double
  196. filespec = '*.*' + SPACE(60)
  197. @ 6,19 SAY 'Enter filespec:' GET filespec PICTURE '@!KS26'
  198. SET CURSOR ON
  199. READ
  200. SET CURSOR OFF
  201. @ 5,15,7,65 BOX single
  202. IF LASTKEY() <> 27
  203.    filename = PICKFILE( TRIM(filespec), 1, 0, 24, democolor, .T. )
  204.    IF .NOT. EMPTY(filename)
  205.       SAYINBOX('You selected &filename',5)
  206.    ENDIF
  207. ENDIF
  208. RETURN
  209.  
  210.  
  211. *-----------------------------------------------------------------------------
  212. PROCEDURE d_decrypted
  213. PRIVATE mstring, estring, dstring
  214. DO ClearTop
  215. SET CURSOR ON
  216. mstring = SPACE(35)
  217. @ 4,0,8,79 BOX double
  218. @ 5,6 SAY 'Enter a string to be encrypted:' GET mstring
  219. READ
  220. estring = ENCRYPTED(ALLTRIM(mstring))
  221. CENTER(6,'Encrypted version is: &estring')
  222. dstring = DECRYPTED(estring)
  223. CENTER(7,'Decrypted version is: &dstring')
  224. SET CURSOR OFF
  225. INKEY(10)
  226. RETURN
  227.  
  228.  
  229. *-----------------------------------------------------------------------------
  230. PROCEDURE d_encrypted
  231. PRIVATE mstring, estring
  232. DO ClearTop
  233. SET CURSOR ON
  234. mstring = SPACE(35)
  235. @ 4,0,7,79 BOX double
  236. @ 5,6 SAY 'Enter a string to be encrypted:' GET mstring
  237. READ
  238. estring = ENCRYPTED(ALLTRIM(mstring))
  239. CENTER(6,'Encrypted version is: &estring')
  240. SET CURSOR OFF
  241. INKEY(10)
  242. RETURN
  243.  
  244.  
  245. *-----------------------------------------------------------------------------
  246. PROCEDURE d_getparm
  247. PRIVATE mstring, mnumber, mparm
  248. DO ClearTop
  249. SET CURSOR ON
  250. mstring = 'Red, Orange, Yellow, Green, Blue, Indigo, Violet'
  251. @ 4,0,9,79 BOX double
  252. CENTER(5,'Enter a string with sections separated by commas')
  253. @ 6,CENTER(mstring) GET mstring PICTURE '@K'
  254. READ
  255. mnumber = 4
  256. @ 7,25 SAY 'Enter parameter to retrieve:' GET mnumber PICTURE '#'
  257. READ
  258. mparm = GETPARM(mnumber,mstring)
  259. CENTER(8, 'Parameter #' + STR(mnumber,1,0) + ' is: &mparm')
  260. SET CURSOR OFF
  261. INKEY(10)
  262. RETURN
  263.  
  264.  
  265. *-----------------------------------------------------------------------------
  266. PROCEDURE d_keyinput
  267. PRIVATE length, upcase, echoon, mstring
  268. length = 60
  269. upcase = .F.
  270. echoon = .T.
  271. DO ClearTop
  272. @ 3,0,11,79 BOX double
  273. @ 4,2 SAY 'Enter maximum allowed key input length: ' GET length PICTURE '###'
  274. @ 5,2 SAY 'Force characters into upper case? (Y/N):' GET upcase PICTURE 'Y'
  275. @ 6,2 SAY 'Echo characters onto the screen? (Y/N): ' GET echoon PICTURE 'Y'
  276. SET CURSOR ON
  277. READ
  278. @ 8,1 SAY 'Start typing:'
  279. mstring = KEYINPUT(length,upcase,echoon)
  280. @ 10,1 SAY 'You entered: ' + mstring
  281. SET CURSOR OFF
  282. INKEY(10)
  283. RETURN
  284.  
  285.  
  286. *-----------------------------------------------------------------------------
  287. PROCEDURE d_namesplit
  288. PRIVATE mname, sname
  289. DO ClearTop
  290. SET CURSOR ON
  291. mname = PAD('Elmer Q. Fudd',35)
  292. @ 4,0,7,79 BOX double
  293. @ 5,6 SAY 'Enter a name to be parsed (split):' GET mname
  294. READ
  295. sname = NAMESPLIT(mname)
  296. CENTER(6,'NAMESPLIT() version is: &sname')
  297. SET CURSOR OFF
  298. INK